home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_gen / instal11.zip / ROUTINES.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-11  |  13KB  |  457 lines
  1. (***********************)
  2. (* managment of dialog *)
  3. (***********************)
  4. unit Routines;
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  10.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, FileCtrl, DdeMan,ShellApi;
  11.  
  12. type
  13.   TDialogue = class(TForm)
  14.     DestDrive: TDriveComboBox;
  15.     TitDrive: TLabel;
  16.     TitPath: TLabel;
  17.     Chemin : TEdit;
  18.     Bevel1 : TBevel;
  19.     Bevel2 : TBevel;
  20.     btInst : TBitBtn;
  21.     btStop : TBitBtn;
  22.     Bevel3 : TBevel;
  23.     WhatUp : TMemo;
  24.     DDEClient: TDdeClientConv;
  25.     Label1: TLabel;
  26.     procedure btInstClick(Sender: TObject);
  27.     procedure btStopClick(Sender: TObject);
  28.     procedure Initialisation(Sender: TObject);
  29.   private
  30.     { Private-dΘclarations }
  31.     function  UnInstall (Number : integer;StrLine : string) : integer;
  32.     function  CreationGroupe (FileName,GroupName : string) : integer;
  33.     function  CreationIcone (FileName,IconName : string) : integer;
  34.     function  ProcCopyFiles : integer;
  35.     function  ProcCopyIcons : integer;
  36.     function  ProcCreateGroupIcon : integer;
  37.     procedure ProcLauchApp;
  38.   public
  39.     { Public-dΘclarations }
  40.   end;
  41.  
  42. var
  43.   Dialogue: TDialogue;
  44.  
  45. implementation
  46.  
  47. uses Decla,Lecture,Disque,UInfo;
  48.  
  49. {$R *.DFM}
  50.  
  51. (****************************)
  52. (* record of uninstall file *)
  53. (****************************)
  54. function TDialogue.UnInstall (Number : integer;StrLine : string) : integer;
  55. var Tmp : integer;
  56.     Fch : System.Text;
  57. begin
  58.  Tmp := 0;
  59.  System.Assign (Fch,VPath [2].LettDriv + ':' + VPath [2].PathDriv + '\' +
  60.                     Fch_UnIns + 'INS');
  61.  {$I-}; Append (Fch); {$I+};
  62.  if IoResult = 0 then
  63.  begin
  64.   Writeln (Fch,Number,',',StrLine);
  65.   System.Close (Fch);
  66.  end
  67.  else
  68.  begin
  69.   {$I-}; Rewrite (Fch); {$I+};
  70.   if IoResult = 0 then
  71.   begin
  72.    Writeln (Fch,Number,',',StrLine);
  73.    System.Close (Fch);
  74.   end
  75.   else
  76.    Tmp := 1;
  77.  end;
  78.  UnInstall := Tmp;
  79. end;
  80.  
  81. (********************)
  82. (* create one group *)
  83. (********************)
  84. function TDialogue.CreationGroupe (FileName,GroupName : string) : integer;
  85. var Tmp : integer;
  86.     Macro : string;
  87.     Cmd   : array [0 .. 255] of Char;
  88.     lgn   : string;
  89. begin
  90.  Tmp := 0;
  91.  if GroupName = '' then
  92.   Tmp := 1
  93.  else
  94.  begin
  95.   Lgn := GroupName + ',' + FileName;
  96.   Macro := Format('[CreateGroup(%s)]', [Lgn]) + #13#10;
  97.   StrPCopy (Cmd, Macro);
  98.   DDEClient.ConnectMode := DDEAutomatic;
  99.   if DDEClient.SetLink('Progman','Progman') = true then
  100.   begin
  101.    if not DDEClient.ExecuteMacro(Cmd, False) then
  102.     Tmp := 2;
  103.    DDEClient.CloseLink;
  104.   end
  105.   else
  106.    Tmp := 3;
  107.  end;
  108.  CreationGroupe := Tmp;
  109. end;
  110.  
  111. (*******************)
  112. (* create one icon *)
  113. (*******************)
  114. function TDialogue.CreationIcone (FileName,IconName : string) : integer;
  115. var Tmp : integer;
  116.     Macro : string;
  117.     Cmd   : array [0 .. 255] of Char;
  118.     lgn   : string;
  119. begin
  120.  Tmp := 0;
  121.  if FileName = '' then
  122.   Tmp := 1
  123.  else
  124.  begin
  125.   Lgn := FileName + ',' + '"' + IconName + '",';
  126.   Macro := Format('[AddItem(%s,%d)]', [Lgn,0]) + #13#10;
  127.   StrPCopy (Cmd, Macro);
  128.   DDEClient.ConnectMode := DDEAutomatic;
  129.   if DDEClient.SetLink('Progman','Progman') = true then
  130.   begin
  131.    if not DDEClient.ExecuteMacro(Cmd, False) then
  132.     Tmp := 2;
  133.    DDEClient.CloseLink;
  134.   end
  135.   else
  136.    Tmp := 3;
  137.  end;
  138.  CreationIcone := Tmp;
  139. end;
  140.  
  141. (**************)
  142. (* copy files *)
  143. (**************)
  144. function TDialogue.ProcCopyFiles : integer;
  145. var Bcl : integer;
  146.     FrF : string;
  147.     ToF : string;
  148.     Tmp : integer;
  149.     Tp1 : integer;
  150. begin
  151.  Tmp := 0;
  152.  if Number_Files > 0 then
  153.  begin
  154.   for Bcl := 1 to Number_Files do
  155.   begin
  156.    if Tmp = 0 then
  157.    begin
  158.     (* check disk *)
  159.     repeat
  160.      if CheckDsk (VPath [1].LettDriv + ':' + VPath [1].PathDriv,
  161.                   VFiles [Bcl].DiskNumb) = 1 then
  162.      begin
  163.       Tp1 := MessageDlg ('Please insert disk #' +
  164.                          IntToStr (VFiles [Bcl].DiskNumb),
  165.                          mtInformation,[mbOk,mbCancel],0);
  166.       if Tp1 = mrCancel then begin Tmp := 2; Tp1 := 2; end
  167.                         else Tp1 := 0;
  168.      end
  169.      else
  170.       Tp1 := 1;
  171.     until Tp1 <> 0;
  172.     if Tp1 = 1 then
  173.     (* copy file *)
  174.     begin
  175.      (* set path,source and target *)
  176.      if VFiles [Bcl].FilePath = '%1' then
  177.       VFiles [Bcl].FilePath := VPath [2].LettDriv + ':' + VPath [2].PathDriv;
  178.      FrF := VPath [1].LettDriv + ':' + VPath [1].PathDriv +
  179.             VFiles [Bcl].FileName;
  180.      ToF := VFiles [Bcl].FilePath + '\' + VFiles [Bcl].FileName;
  181.      WhatUp.Lines.Add ('Copy from ' + FrF + ' to ' + ToF);
  182.      if EnougthSpace (ToF [1],FrF) = 0 then
  183.      begin
  184.       Screen.Cursor := crHourGlass;
  185.       if CopyFile (FrF,ToF,1) <> 0 then
  186.       (* problem during copy *)
  187.        Tmp := 1
  188.       else
  189.        UnInstall (1,ToF);
  190.       Screen.Cursor := crDefault;
  191.      end
  192.      else
  193.      (* not enought space drive *)
  194.       Tmp := 2;
  195.     end
  196.     else
  197.     (* wrong disk in drive *)
  198.      Tmp := 3;
  199.    end;
  200.   end;
  201.  end;
  202.  ProcCopyFiles := Tmp;
  203. end;
  204.  
  205. (********************)
  206. (* copy icons files *)
  207. (********************)
  208. function TDialogue.ProcCopyIcons : integer;
  209. var Bcl : integer;
  210.     FrF : string;
  211.     ToF : string;
  212.     Tmp : integer;
  213.     Tp1 : integer;
  214. begin
  215.  Tmp := 0;
  216.  if Number_Icons > 0 then
  217.  begin
  218.   for Bcl := 1 to Number_Icons do
  219.   begin
  220.    repeat
  221.     if CheckDsk (VPath [1].LettDriv + ':' + VPath [1].PathDriv,
  222.                  VIcons [Bcl].DiskNumb) = 1 then
  223.     begin
  224.      Tp1 := MessageDlg ('Please insert disk #' +
  225.                         IntToStr (VFiles [Bcl].DiskNumb),
  226.                         mtInformation,[mbOk,mbCancel],0);
  227.      if Tp1 = mrCancel then Tp1 := 2
  228.                        else Tp1 := 0;
  229.     end
  230.     else
  231.      Tp1 := 1;
  232.    until Tp1 <> 0;
  233.    if Tp1 = 1 then
  234.    begin
  235.     (* set path,source and target *)
  236.     if VIcons [Bcl].FilePath = '%1' then
  237.      VIcons [Bcl].FilePath := VPath [2].LettDriv + ':' + VPath [2].PathDriv;
  238.     FrF := VPath [1].LettDriv + ':' + VPath [1].PathDriv +
  239.            VIcons [Bcl].FileName;
  240.     ToF := VIcons [Bcl].FilePath + '\' + VIcons [Bcl].FileName;
  241.     WhatUp.Lines.Add ('Copy from ' + FrF + ' to ' + ToF);
  242.     if EnougthSpace (ToF [1],FrF) = 0 then
  243.     begin
  244.      Screen.Cursor := crHourGlass;
  245.      if CopyFile (FrF,ToF,1) <> 0 then
  246.      (* problem during copy *)
  247.       Tmp := 1
  248.      else
  249.       UnInstall (1,ToF);
  250.      Screen.Cursor := crDefault;
  251.     end
  252.     else
  253.     (* not enought drive space *)
  254.      Tmp := 2;
  255.    end
  256.    else
  257.    (* wrong disk in drive *)
  258.     Tmp := 3;
  259.   end;
  260.  end;
  261.  ProcCopyIcons := Tmp;
  262. end;
  263.  
  264. (*************************)
  265. (* create group and icon *)
  266. (*************************)
  267. function TDialogue.ProcCreateGroupIcon : integer;
  268. var Bcl : integer;
  269.     Ico : string;
  270.     Tmp : integer;
  271.     Tp1 : integer;
  272. begin
  273.  Tmp := 0;
  274.  (* create group *)
  275.  if Number_Group > 0 then
  276.  begin
  277.   for Bcl := 1 to Number_Group do
  278.   begin
  279.    WhatUp.Lines.Add ('Create group ' + VGroup [Bcl].GroupName);
  280.    Tp1 := CreationGroupe (VGroup [Bcl].GroupFile,VGroup [Bcl].GroupName);
  281.    Case Tp1 of
  282.     1 : WhatUp.Lines.Add ('Group name is needed');
  283.     2 : WhatUp.Lines.Add ('Problem(s) with Program Manager');
  284.     3 : WhatUp.Lines.Add ('Unable to lauch Program Manager');
  285.    else
  286.     UnInstall (2,VGroup [Bcl].GroupFile);
  287.    end;
  288.    if Tp1 <> 0 then Tmp := 4;
  289.   end;
  290.  end;
  291.  (* create icons *)
  292.  if Tmp = 0 then
  293.  begin
  294.   if Number_Icons > 0 then
  295.   begin
  296.    for Bcl := 1 to Number_Icons do
  297.    begin
  298.     Ico := VIcons [Bcl].FilePath + '\' + VIcons [Bcl].FileName;
  299.     WhatUp.Lines.Add ('Create icon ' + VIcons [Bcl].IconName);
  300.     Tp1 := CreationIcone (Ico,VIcons [Bcl].IconName);
  301.     Case Tp1 of
  302.      1 : WhatUp.Lines.Add ('File name is needed');
  303.      2 : WhatUp.Lines.Add ('Problem(s) with Program Manager');
  304.      3 : WhatUp.Lines.Add ('Unable to lauch Program Manager');
  305.     end;
  306.     if Tp1 <> 0 then Tmp := 5;
  307.    end;
  308.   end;
  309.  end;
  310.  ProcCreateGroupIcon := Tmp;
  311. end;
  312.  
  313. (*********************)
  314. (* lauch application *)
  315. (*********************)
  316. procedure TDialogue.ProcLauchApp;
  317. var Bcl : integer;
  318.     App : string;
  319. begin
  320.  if Number_Run > 0 then
  321.  begin
  322.   for Bcl := 1 to Number_Run do
  323.   begin
  324.    if VRun [Bcl].FilePath = '%1' then
  325.     VRun [Bcl].FilePath := VPath [2].LettDriv + ':' + VPath [2].PathDriv;
  326.    if VRun [Bcl].DocsPath = '%1' then
  327.     VRun [Bcl].DocsPath := VPath [2].LettDriv + ':' + VPath [2].PathDriv;
  328.    App := VRun [Bcl].DocsPath + '\' + VRun [Bcl].DocsName;
  329.    StartApp (VRun [Bcl].FileName,App,VRun [Bcl].FilePath);
  330.   end;
  331.  end;
  332. end;
  333.  
  334. (******************)
  335. (* install button *)
  336. (******************)
  337. procedure TDialogue.btInstClick(Sender: TObject);
  338. var Bcl : integer;
  339.     FrF : string;
  340.     ToF : string;
  341.     Tmp : integer;
  342.     Tp1 : integer;
  343. begin
  344.  Error := 0;
  345.  (* set new user path *)
  346.  VPath [2].LettDriv := DestDrive.Drive;
  347.  VPath [2].PathDriv := Chemin.Text;
  348.  (* desactivate all exept cancel button *)
  349.  TitDrive.Enabled := false;
  350.  DestDrive.Enabled := false;
  351.  TitPath.Enabled := false;
  352.  Chemin.Enabled := false;
  353.  btInst.Enabled := false;
  354.  WhatUp.Enabled := false;
  355.  (* installation script *)
  356.  if Error = 0 then
  357.  begin
  358.   if CreateDirectory (VPath [2].LettDriv + ':' + VPath [2].PathDriv) = 1 then
  359.    WhatUp.Lines.Add ('Unable to create the directory')
  360.   else
  361.    UnInstall (0,VPath [2].LettDriv + ':' + VPath [2].PathDriv);
  362.   if Error = 0 then Error := ProcCopyFiles;
  363.   if Error = 0 then Error := ProcCopyIcons;
  364.   if Error = 0 then Error := ProcCreateGroupIcon;
  365.   if Error = 0 then ProcLauchApp;
  366.  end;
  367.  (* conclusion *)
  368.  if Error = 0 then
  369.  begin
  370.   WhatUp.Lines.Add ('Installation of ' + Title + ' successfull');
  371.   btStop.Enabled := false;
  372.   Info.ShowModal;
  373.   Close;
  374.  end
  375.  else
  376.  begin
  377.   WhatUp.Lines.add ('Installation of ' + Title + ' unsuccessfull');
  378.   Case Error of
  379.    1 : WhatUp.Lines.add ('because problem when copying file(s)');
  380.    2 : WhatUp.Lines.add ('because not enought drive space or file doesn''t exist');
  381.    3 : WhatUp.Lines.add ('because wrong disk in drive');
  382.    4 : WhatUp.Lines.add ('because unable to create group(s)');
  383.    5 : WhatUp.Lines.add ('because unable to create icon(s)');
  384.    6 : WhatUp.Lines.add ('because install file is corrupt');
  385.   end;
  386.   btInst.Enabled := true;
  387.  end;
  388. end;
  389.  
  390. (*****************)
  391. (* cancel button *)
  392. (*****************)
  393. procedure TDialogue.btStopClick(Sender: TObject);
  394. begin
  395.  if btInst.Enabled = false then
  396.   WhatUp.Lines.Add ('Installation cancelled by user');
  397.  Close;
  398. end;
  399.  
  400. (* dialog initialisation *)
  401. procedure TDialogue.Initialisation(Sender: TObject);
  402. var erreur : integer;
  403.     lerror : string;
  404. begin
  405.  (* variables iniialisation *)
  406.  WhatUp.Clear;
  407.  Chemin.Text := '';
  408.  btInst.Enabled := false;
  409.  Screen.Cursor := crHourGlass;
  410.  (* read install file *)
  411.  LError := '';
  412.  Erreur := ReadInsFile;
  413.  case Erreur of
  414.   01 : LError := 'Unable to find install file (.INS)';
  415.   02 : LError := 'Unable to open install file';
  416.   03 : LError := 'Unable to read one line of install file';
  417.   04 : LError := 'Wrong paragraph name';
  418.   05 : LError := 'Wrong line because = sign is needed';
  419.   06 : LError := 'Wrong line because Unable to find paragraph';
  420.   07 : LError := 'Wrong line in Mauvaise ligne dans le paragraphe INFORMATION';
  421.   08 : LError := 'Wrong line in DISKS paragraph';
  422.   09 : LError := 'Wrong line in ORIGIN paragraph';
  423.   10 : LError := 'Wrong line in DESTINATION paragraph';
  424.   11 : LError := 'Wrong line in GROUP paragraph';
  425.   12 : LError := 'Wrong line in ICONS paragraph';
  426.   13 : LError := 'Wrong line in FILES paragraph';
  427.   14 : LError := 'Wrong line in RUN paragraph';
  428.   15 : LError := 'NUM parameter is wrong';
  429.   16 : LError := 'Number before = is wrong';
  430.   17 : LError := 'Wrong parameter in GROUP line';
  431.   18 : LError := 'Wrong parameter in ICONS line';
  432.   19 : LError := 'Wrong parameter in FILES line';
  433.   20 : LError := 'Wrong parameter in RUN line';
  434.   21 : LError := 'Wrong parameter in DSK line';
  435.  end;
  436.  Screen.Cursor := crDefault;
  437.  if LError <> '' then
  438.  (* install file is wrong *)
  439.   MessageDlg (LError,mtError,[mbok],0)
  440.  else
  441.  begin
  442.   btInst.Enabled := true;
  443.   Chemin.Text := VPath [2].PathDriv;
  444.   DestDrive.Drive := VPath [2].LettDriv;
  445.   Caption := 'Install ' + Title + ' v ' + Version;
  446.   WhatUp.Lines.Add (Title + ' v ' + Version);
  447.   WhatUp.Lines.Add (SubTitle);
  448.   WhatUp.Lines.Add ('(c)' + Copyright + ' by ' + Author);
  449.   WhatUp.Lines.Add ('');
  450.   WhatUp.Lines.Add ('Installation of ' + Title + ' starting');
  451.   Error := 0;
  452.  end;
  453. end;
  454.  
  455. end.
  456.  
  457.